perm filename ROTB.SAI[1,JMC] blob
sn#005246 filedate 1970-01-04 generic text, type T, neo UTF8
00100 begin integer m,n,p,q,i,j,brk; real c,dc,x,y,z,w,dx,cmin,cmax,
00200 dc0,xmin,xmax; label a,b,aa,bb,cc;
00300 external real procedure realscan(reference string x;reference integer xx);
00400 string temp_shit;
00500 real procedure r(real u,lam);begin return(
00600 lam+u*(2-u)
00700 ) end;
00710 real procedure sqrt(real x); begin real y; integer i;
00720 y←0.5*(x+1.0);
00730 for i←1 step 1 until 4 do
00740 y←0.5*(1.0+x/y) end;
00800 aa:
00900 outstr("
01000
01100 p="); p←cvd(inchwl); outstr("q="); q←cvd(inchwl);
01200
01300 c←0; dc←p/q;
01400
01500 b:
01600 c←c+dc;x←0.0;
01700
01800 y←x;m←0;
01900 for i←1 step 1 until q do begin
02000 m←m+(j←z←c+sqrt(y));y←z-j end;
02100 if m > 0 then begin if y<x then m←m-1 end
02200 else if m<0 then begin if y>x then m←m+1 end;
02300
02400 if m=p then go to a;
02500 if ((m<p) and (dc<0)) or ((m>p) and (dc>0)) then dc←-0.5*dc;
02600 go to b;
02700
02800 a:
02900 outstr("c ="&cvf(c)&" dc ="&cvf(dc)&" m ="&cvs(m)
03000 &" y ="&cvf(y));
03100
03200 y←0;w←p;
03300 for i←1 step 1 until q do
03400 begin j←z←c+sqrt(y);y←z-j;if 0<y<w then w←y end;
03500 dx←.01*w;
03600
03700 dc0←dc←abs(dc);
03800 bb:
03900 for x←0.0 step dx until w+w do begin
04000 y←x;m←0;
04100 for i←1 step 1 until q do begin
04200 m←m+(j←z←c+sqrt(y));y←z-j end;
04300 if m > 0 then begin if y<x then m←m-1 end
04400 else if m<0 then begin if y>x then m←m+1 end;
04500
04600 if m=p then begin c←c-dc;xmin←x; go to bb end end;
04700 if dc>0.1@-6 then begin dc←0.5*dc;c←c+dc;go to bb end;
04800
04900 cmin←c←c+dc; dc←dc0;
05000 cc:
05100 for x←0.0 step dx until w do begin
05200 y←x;m←0;
05300 for i←1 step 1 until q do begin
05400 m←m+(j←z←c+sqrt(y));y←z-j end;
05500 if m > 0 then begin if y<x then m←m-1 end
05600 else if m<0 then begin if y>x then m←m+1 end;
05700
05800 if m=p-1 then begin c←c+dc;xmax←x; go to cc end end;
05900 if dc>0.1@-6 then begin dc←0.5*dc;c←c-dc;go to cc end;
06000 cmax←c←c-dc;
06100
06200 outstr("
06300 cmin ="&cvf(cmin)&" cmax ="&cvf(cmax)&" range ="
06400 &cvf(cmax-cmin)&"
06500 xmin ="&cvf(xmin)&" xmax ="&cvf(xmax)&" w ="&cvf(w));
06600 go to aa end;